home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DRIVES.SWG / 0023_Get Drive ID & Labels.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-22  |  4KB  |  154 lines
  1. UNIT FCBLabel;
  2. {Turbo Pascal unit for manipulating volume labels}
  3.  
  4. INTERFACE
  5. USES
  6.     DOS;
  7. TYPE
  8.     DriveType   = String[1];
  9.     DiskIDType  = String[11];
  10.  
  11. FUNCTION GetDiskID(Drive:DriveType): DiskIDType;
  12. FUNCTION SetDiskID(Drive:DriveType;
  13.                     DiskID:DiskIDType): Boolean;
  14. FUNCTION ReNameDiskID(Drive:DriveType;
  15.                    OldDiskID:DiskIDType;
  16.                    NewDiskID:DiskIDType): Boolean;
  17. FUNCTION DeleteDiskID(Drive:DriveType): Boolean;
  18.  
  19. IMPLEMENTATION
  20. TYPE
  21.     ExtendedFCBRecord = RECORD
  22.                ExtFCB : Byte;
  23.                Res1   : ARRAY[1..5] OF Byte;
  24.                Attr   : Byte;
  25.                Drive  : Byte;
  26.                Name1  : ARRAY[1..11] OF Char;
  27.                Unused1: ARRAY[1..5] OF Char;
  28.                Name2  : ARRAY[1..11] OF Char;
  29.                Unused2: ARRAY[1..9] OF Byte;
  30.            END;
  31.  
  32. FUNCTION GetDiskID(Drive:DriveType): DiskIDType;
  33. VAR
  34.    DirInfo     : SearchRec;
  35.    DirDiskID   : String[12];
  36.    I,PosPeriod : Byte;
  37. BEGIN
  38.    FindFirst(Drive+':\'+'*.*',VolumeID,DirInfo);
  39.    IF DosError = 0 THEN
  40.       BEGIN
  41.          DirDiskID := DirInfo.Name;
  42.          PosPeriod := POS('.',DirDiskID);
  43.          IF PosPeriod > 0 THEN
  44.             Delete(DirDiskID,PosPeriod,1);
  45.          GetDiskID := DirDiskID
  46.       END
  47.    ELSE
  48.       GetDiskID := ''
  49. END;
  50.  
  51. {Use MsDos service 16H to SET a volume label }
  52. FUNCTION SetDiskID(Drive:DriveType;
  53.                     DiskID:DiskIDType): Boolean;
  54. VAR
  55.    FCB  : ExtendedFCBRecord;
  56.    Regs : Registers;
  57.    Temp : String[1];
  58.    I    : Integer;
  59. BEGIN
  60.    Temp := Drive;
  61.    WITH FCB DO
  62.      BEGIN
  63.        ExtFCB := $FF;
  64.        Attr   := $8;
  65.        Drive  := Ord(UpCase(Temp[1])) - 64;
  66.        FOR I := 1 TO Length(DiskID) DO
  67.          Name1[I] := DiskID[I];
  68.          IF Length(DiskID) < 11 THEN
  69.            FOR I := (Length(DiskID) + 1) TO 11 DO
  70.              Name1[I] := ' '
  71.      END;
  72.    Regs.ah := $16;
  73.    Regs.ds := Seg(FCB);
  74.    Regs.dx := Ofs(FCB);
  75.    MsDos(Regs);
  76.    IF Regs.AL = 0 THEN
  77.       SetDiskID := TRUE
  78.    ELSE
  79.       SetDiskID := FALSE
  80. END;
  81.  
  82. {use MsDOS service 17H to RENAME a volume label }
  83. FUNCTION ReNameDiskID(Drive:DriveType;
  84.                    OldDiskID:DiskIDType ;
  85.                    NewDiskID:DiskIDType): Boolean;
  86. VAR
  87.    FCB  : ExtendedFCBRecord;
  88.    Regs : Registers;
  89.    Temp : String[1];
  90.    I    : Integer;
  91. BEGIN
  92.   Temp := Drive;
  93.   WITH FCB DO
  94.     BEGIN
  95.       ExtFCB := $FF;
  96.       Attr   := $8;
  97.       Drive  := Ord(UpCase(Temp[1])) - 64;
  98.  
  99.       {Set old disk id}
  100.  
  101.       FOR I := 1 TO Length(OldDiskID) DO
  102.         Name1[I] := OldDiskID[I];
  103.       FOR I := (Length(OldDiskID) + 1) TO 11 DO
  104.         Name1[I] := ' ';
  105.  
  106.       {Set new disk id}
  107.  
  108.       FOR I := 1 TO Length(NewDiskID) DO
  109.         Name2[I] := NewDiskID[I];
  110.       FOR I := (Length(NewDiskID) + 1) TO 11 DO
  111.         Name2[I] := ' '
  112.     END;
  113.   Regs.ah := $17;
  114.   Regs.ds := Seg(FCB);
  115.   Regs.dx := Ofs(FCB);
  116.   MsDos(Regs);
  117.   IF Regs.AL = 0 THEN
  118.      ReNameDiskID := TRUE
  119.   ELSE
  120.      ReNameDiskID := FALSE
  121. END;
  122.  
  123. {Use MsDos service 13H DELETE a volume label }
  124.  
  125. FUNCTION DeleteDiskID(Drive:DriveType): Boolean;
  126. VAR
  127.   FCB  : ExtendedFCBRecord;
  128.   Regs : Registers;
  129.   Temp : String[1];
  130.   I    : Integer;
  131. BEGIN
  132.   Temp := Drive;
  133.   WITH FCB DO
  134.     BEGIN
  135.       ExtFCB := $FF;
  136.       Attr   := $8;
  137.       Drive  := Ord(UpCase(Temp[1])) - 64;
  138.       Name1[1] := '*';
  139.       Name1[2] := '.';
  140.       Name1[3] := '*';
  141.       FOR I := 4 TO 11 DO Name1[I] := ' '
  142.     END;
  143.   Regs.ah := $13;
  144.   Regs.ds := Seg(FCB);
  145.   Regs.dx := Ofs(FCB);
  146.   MsDos(Regs);
  147.   IF Regs.AL = 0 THEN
  148.      DeleteDiskID := TRUE
  149.   ELSE
  150.      DeleteDiskID := FALSE
  151. END;
  152.  
  153. END.
  154.